#!/usr/bin/perl
###############################################################################

#my $colorConvertString = chr(0x00).chr(0x24).chr(0x49).chr(0x6D).chr(0x92).chr(0xB6).chr(0xDB).chr(0xFF);

use strict;
use warnings;

if ( $#ARGV < 3 ) {
    die "\nscdextracttile <palfile>:[pb]<int> <tilefile>:[tb]<int>:<int> <bmpwidth> <magicpink>\n\n";
}

my $paletteInfo = shift @ARGV;
my $tileInfo = shift @ARGV;
my $width = shift @ARGV;
my $magicPink = shift @ARGV;

my $paletteData = &ReadPalette($paletteInfo);

my $tileData = &ReadTile($tileInfo);

&MakeBMP($tileData,$width,'TMP.BMP');

sub ReadPalette {
    my ($paletteInfo) = @_;
    my $paletteType = 'p';
    my $paletteOffset = 0;
    if ( $paletteInfo !~ m/^([^:]+):([pb])([0-9]+)$/ &&
	 $paletteInfo !~ m/^([^:]+)$/ ) {
	die "Bad palette info: $paletteInfo";
    }
    my $paletteFile = $1;
    if ( defined $2 ) {
	$paletteType = $2;
    }
    if ( defined $3 ) {
	$paletteOffset = $3;
    }
    if ( $paletteType eq 'p' ) {
	$paletteOffset *= 32;
    }
    if ( ! -e $paletteFile ) {
	die "Bad palette file: $paletteFile";
    }
    if ( $paletteFile =~ m/\.asm$/i ) {
	my $paletteAsmFile = $paletteFile;
	$paletteFile = 'TMP.BIN';
	system("scdasm $paletteAsmFile $paletteFile");
	if ( ! -e $paletteFile ) {
	    die "Bad scdasm since didn't make: $paletteFile";
	}
    }

    my $paletteData = chr(0x00)x32;

    open( PALETTE, $paletteFile ) or die "Cannot read palette file: $!\n";
    binmode PALETTE;
    seek(PALETTE,$paletteOffset,0);
    my $paletteDataBuffer;
    if ( read(PALETTE,$paletteDataBuffer,32) == 32 ) {
	$paletteData = $paletteDataBuffer;
    }
    close PALETTE;

    return $paletteData;
}

sub ReadTile {
    my ($tileInfo) = @_;
    if ( $tileInfo !~ m/^([^:]+):([tb])([0-9]+):([0-9]+)$/ ) {
	die "Bad tile info: $tileInfo";
    }
    my $tileFile = $1;
    my $tileType = $2;
    my $tileOffset = $3;
    my $tileCount = $4;
    if ( $tileType eq 't' ) {
	$tileOffset *= 32;
    }
    if ( ! -e $tileFile ) {
	die "Bad tile file: $tileFile";
    }
    if ( $tileFile =~ m/\.asm$/i ) {
	my $tileAsmFile = $tileFile;
	$tileFile = 'TMP.BIN';
	system("scdasm $tileAsmFile $tileFile");
	if ( ! -e $tileFile ) {
	    die "Bad scdasm since didn't make: $tileFile";
	}
    }

    my $tileData = chr(0x00)x(32*$tileCount);

    open( TILE, $tileFile ) or die "Cannot read tile file: $!\n";
    binmode TILE;
    seek(TILE,$tileOffset,0);
    my $tileDataBuffer;
    if ( read(TILE,$tileDataBuffer,(32*$tileCount)) == (32*$tileCount) ) {
	$tileData = $tileDataBuffer;
    }
    close TILE;

    return $tileData;
}

sub Convert3BitColorTo8BitColor {
    my ($bit3) = @_;
    return int( ( $bit3 & 0x07 ) * 0xFF / 0x07 + 0.5 );
}

sub Convert8BitColorTo3BitColor {
    my ($bit8) = @_;
    return int( ( $bit8 & 0xFF ) * 0x07 / 0xFF + 0.5 );
}

sub MakeBMP {
    my ($binBuffer,$width,$bmpFile) = @_;

    open( BMP, ">$bmpFile" ) or die "Cannot write bmp: $!\n";

    my $binBufferLength = length($binBuffer);
    my $height = $binBufferLength*2/$width;

    binmode BMP;

    # header and 16 color palette, data must start on quadbyte boundary
    my $dataStart = 0x78;
    my $size = $dataStart+$binBufferLength;

    # BM
    print BMP "BM";
    # size
    print BMP pack("V",$size);
    # reserved
    print BMP pack("v",0);
    # reserved
    print BMP pack("v",0);
    # start of BMP data
    print BMP pack("V",$dataStart);

    # length of this header
    print BMP pack("V",0x28);
    # width
    print BMP pack("V",$width);
    # height
    print BMP pack("V",$height);
    # 1 plane
    print BMP pack("v",1);
    # 4 bits/pixel
    print BMP pack("v",4);
    # no compression
    print BMP pack("V",0);
    # size of raw BMP data (0x20 bytes)
    print BMP pack("V",$binBufferLength);
    # horizontal resolution
    print BMP pack("V",0);
    # vertical resolution
    print BMP pack("V",0);
    # 16 colors in palette
    print BMP pack("V",16);
    # number of important colors
    print BMP pack("V",0);

    # start of palette (BGR)

    for ( my $pIndex = 0; $pIndex < 16; $pIndex++ ) {
	my $pValue0;
	my $pValue1;
	if ( $magicPink && $pIndex == 0 ) {
	    $pValue0 = 0x0E;
	    $pValue1 = 0x0E;
	} else {
	    $pValue0 = ord(substr($paletteData,$pIndex*2,1));
	    $pValue1 = ord(substr($paletteData,$pIndex*2+1,1));
	}
	print BMP
	    chr(&Convert3BitColorTo8BitColor($pValue0 >> 1)).
	    chr(&Convert3BitColorTo8BitColor($pValue1 >> 5)).
	    chr(&Convert3BitColorTo8BitColor($pValue1 >> 1)).
	    chr(0x00);
    }

    # pad so we have each row on a 4 byte boundary
    print BMP chr(0x00).chr(0x00);

    # start of BMP data
    # start is lower left corner where tile is upper left corner
    for ( my $row = 0; $row < $height; $row++ ) {
	for ( my $col = 0; $col < $width; $col += 8 ) {
	    print BMP substr($binBuffer,$binBufferLength*$col/$width+($height-$row-1)*4,4);
	}
    }

    close BMP;
}
